-- {-# LANGUAGE MultiParamTypeClasses  #-}
-- {-# LANGUAGE FlexibleInstances  #-}
module Algebras (
-- | data type
    DTensor,
-- | typeclass
    Eq,
    Abelian_Group,
-- | operator 
    tensorrm2list,
    create_tensor,
    someFunc
    )where

-- import qualified  Data.Map as M 
import qualified Data.Map as M
-- | the key point is that the data type doesn't decide algebras but the operators decides
-- so the types constructor and data constructor  is not concise with math in haskell 
--  

-- | Countable Abelian group
data DAbelian_G_Base= DAbelian_G_Base_Cons {get_dagb_space_name::String ,get_dagb_i::Int}| DAbelian_G_Base_Zero 
    deriving(Show)


-- data DAbelian_G_Plus= DAbelian_G_Plus_Cons DAbelian_G_Plus DAbelian_G_Base | DAbelian_G_Plus_Zero
--     deriving(Show)


-- | vector is tensor
----tensor is R module 
--- a is domain
--  domain is ring
-- Num class is domain

data Tensor_Base = Tensor_Base_Cons Tensor_Base  DAbelian_G_Base| Tensor_Base_Zero
    deriving(Show)

-- | tensor with R_Module

data (Num a,Eq a)=>Tensor_Base_RM a = Tensor_Base_RM_Cons a Tensor_Base|Tensor_Base_RM_Zero
    deriving(Show)

-- | tensor plus struct

data (Num a,Eq a)=>DTensor a= DTensor_Cons (DTensor a) (Tensor_Base_RM a)| DTensor_Zero
    deriving(Show)


create_tensor_brm::(Num a,Eq a)=>(a,[(String,Int)])->Tensor_Base_RM a
create_tensor_brm (0,_) =Tensor_Base_RM_Zero
create_tensor_brm (_,[]) =Tensor_Base_RM_Zero
create_tensor_brm (v ,l)=Tensor_Base_RM_Cons v (myfun Tensor_Base_Zero l)
    where 
        myfun :: Tensor_Base -> [(String,Int)]->Tensor_Base
        myfun y []= y  
        myfun y (x:xs)=myfun (Tensor_Base_Cons y (DAbelian_G_Base_Cons (fst x) (snd x) )) xs    

create_tensor::(Num a,Eq a)=>[(a,[(String,Int)])]->DTensor a
create_tensor []=DTensor_Zero
create_tensor (x:xs) = DTensor_Cons (create_tensor xs) (create_tensor_brm x)


tensorrm2list::(Num a,Eq a)=>Tensor_Base_RM a->(a,[(String,Int)])
tensorrm2list Tensor_Base_RM_Zero =(0,[])
tensorrm2list (Tensor_Base_RM_Cons v x)=(v,myfun x [])
    where 
        myfun:: Tensor_Base->[(String,Int)]->[(String,Int)]
        myfun Tensor_Base_Zero y = y
        myfun (Tensor_Base_Cons p1 p2) y=  myfun p1 $ (get_dagb_space_name p2,get_dagb_i p2) : y 

-- | show tensor

tensor2list::(Num a,Eq a)=>DTensor a->[(a,[(String,Int)])]
tensor2list DTensor_Zero =[]
tensor2list (DTensor_Cons xs x)=(tensorrm2list x):(tensor2list xs) 



-- data R_Module_Base a=R_Module_Base_Cons a Int | R_Module_Base_Zero 
--     deriving (Show)
---R module action on abelian group
--a is ring 
-- vector is one kind of R_Module,so the R_Moule_Plus can represent vector
-- data R_Module_Plus a= R_Module_Plus_Cons (R_Module_Plus a ) (R_Module_Base a)|R_Module_Plus_Zero
--     deriving(Show)
--Tensor
-- a is ring 
---
-- data Tensor_Base a=Tensor_Base_Cons a Int 
-- data Tensor a =Tensor_Cons (Tensor a) (R_Module_Plus a)| Tensor_Zero
--     deriving(Show)

-- type RMP a=R_Module_Plus a

-- |Abelian  group

instance  Ord DAbelian_G_Base where
    x >y = if (get_dagb_space_name x > get_dagb_space_name y)
        then True
        else if (get_dagb_space_name y >get_dagb_space_name x)
        then False
        else
            if(get_dagb_i x > get_dagb_i y)
            then True
            else 
                False

    x<y = if (get_dagb_space_name y > get_dagb_space_name x)
        then True
        else if (get_dagb_space_name x >get_dagb_space_name y)
        then False
        else
            if(get_dagb_i y > get_dagb_i x)
            then True
            else 
                False

    x>=y=not (x<y)
    x<= y= not (x>y)

instance Eq DAbelian_G_Base  where
    DAbelian_G_Base_Zero == DAbelian_G_Base_Zero = True 
    DAbelian_G_Base_Zero == _ = False
    _ == DAbelian_G_Base_Zero =False

    DAbelian_G_Base_Cons a s1 == DAbelian_G_Base_Cons b s2= (a==b&&s1==s2 )
    

instance  Eq Tensor_Base  where
    Tensor_Base_Zero== Tensor_Base_Zero= True
    Tensor_Base_Zero == _ =False
    _ == Tensor_Base_Zero= False
    Tensor_Base_Cons x y== Tensor_Base_Cons x1 y1=if y1== y
        then  x == x1
        else
            False 

instance  (Eq a,Num a ) =>Eq (Tensor_Base_RM a) where
    Tensor_Base_RM_Zero==Tensor_Base_RM_Zero=True
    Tensor_Base_RM_Zero == _ = False      
    _ == Tensor_Base_RM_Zero = False
    Tensor_Base_RM_Cons a x== Tensor_Base_RM_Cons b y = if a== b 
        then if a==0 
            then True
            else
                x==y
        else
            False  
instance (Eq a,Num a)=> Eq (DTensor a) where
    DTensor_Zero==DTensor_Zero=True
    DTensor_Zero == _ =False
    _ == DTensor_Zero =False
    x==y= (x Algebras.- y) ==DTensor_Zero


class Abelian_Group a where
    (+):: a->a->a
    (-):: a->a->a


tool_plus:: (Eq a,Num a)=>DTensor a->Tensor_Base_RM a->DTensor a
tool_plus x Tensor_Base_RM_Zero = x
tool_plus DTensor_Zero x = DTensor_Cons DTensor_Zero x
tool_plus (DTensor_Cons x1 x2) b=if temp_v2
    then if temp_v1==Tensor_Base_RM_Zero
        then x1
        else
            DTensor_Cons x1 temp_v1
    else
        DTensor_Cons r1 x2
        where
            r1=tool_plus x1 b
            (temp_v1,temp_v2)=temp_plus_base x2 b
            temp_plus_base:: (Num a,Eq a)=>Tensor_Base_RM a->Tensor_Base_RM a->(Tensor_Base_RM a,Bool)
            temp_plus_base Tensor_Base_RM_Zero x=(x,True)
            temp_plus_base x Tensor_Base_RM_Zero=(x,True)
            temp_plus_base (Tensor_Base_RM_Cons p1 p2) (Tensor_Base_RM_Cons p3 p4)=if p2==p4 
                then if(p1 Prelude.+p3)==0 
                    then (Tensor_Base_RM_Zero,True)
                    else
                        (Tensor_Base_RM_Cons (p1 Prelude.+ p3) p2, True)  
                else
                    (Tensor_Base_RM_Zero,False)



tool_negation1::(Eq a,Num a)=> Tensor_Base_RM a->Tensor_Base_RM a
tool_negation1 Tensor_Base_RM_Zero = Tensor_Base_RM_Zero
tool_negation1 (Tensor_Base_RM_Cons p1 p2)= Tensor_Base_RM_Cons (0 Prelude.- p1) p2


tool_negation2:: (Eq a,Num a)=> DTensor a->DTensor a
tool_negation2 DTensor_Zero =DTensor_Zero
tool_negation2 (DTensor_Cons p1 p2)= DTensor_Cons (tool_negation2 p1) (tool_negation1 p2)




instance  (Num a,Eq a)=>Abelian_Group (DTensor a )where
    DTensor_Zero + x=x
    x+ DTensor_Zero=x 
    x+ DTensor_Cons y1 y2=(tool_plus x y2) Algebras.+ y1

    x - y= x Algebras.+ (tool_negation2 y) 




tool_tensor_product_tensor_base::Tensor_Base->Tensor_Base->Tensor_Base
tool_tensor_product_tensor_base Tensor_Base_Zero x = x
tool_tensor_product_tensor_base x Tensor_Base_Zero =x
tool_tensor_product_tensor_base t1 (Tensor_Base_Cons t2 x )=Tensor_Base_Cons (tool_tensor_product_tensor_base t1 t2) x

tool_tensor_product_tensor_base_rm::(Eq a,Num a)=>Tensor_Base_RM a->Tensor_Base_RM a->Tensor_Base_RM a
tool_tensor_product_tensor_base_rm Tensor_Base_RM_Zero _=Tensor_Base_RM_Zero
tool_tensor_product_tensor_base_rm _ Tensor_Base_RM_Zero=Tensor_Base_RM_Zero
tool_tensor_product_tensor_base_rm (Tensor_Base_RM_Cons a1 x1) (Tensor_Base_RM_Cons a2 x2)=Tensor_Base_RM_Cons (a1*a2) (tool_tensor_product_tensor_base x1 x2)




-- tool_tensor_product_tensor_base_rm::(Eq a,Num a)=>DTensor a->Tensor_Base_RM a->DTensor a
-- tool_tensor_product_tensor_base_rm DTensor_Zero x=DTensor_Zero 
-- tool_tensor_product_tensor_base_rm x Tensor_Base_RM_Zero =DTensor_Zero
-- tool_tensor_product_tensor_base_rm  (DTensor_Cons t1 x) y= DTensor_Cons (tool_tensor_product_tensor_base x y) 



class Tensor_Product a where
    (<*>):: a->a->a 

class Wedges_Product a where
    (<^>):: a->a ->a


instance (Num a,Eq a)=> Tensor_Product (DTensor a) where
    DTensor_Zero <*> x =DTensor_Zero
    x <*> DTensor_Zero =DTensor_Zero
    t1 <*> (DTensor_Cons t2 x )= (myfun t1 x) Algebras.+ (t1 Algebras.<*> t2)
        where
            myfun ::(Eq a,Num a)=> DTensor a->Tensor_Base_RM a->DTensor a
            myfun DTensor_Zero _ =DTensor_Zero
            myfun _ Tensor_Base_RM_Zero =DTensor_Zero
            myfun (DTensor_Cons t1 x1) x2= DTensor_Cons (myfun t1 x2) (tool_tensor_product_tensor_base_rm x1 x2)  



tool_wedge_product1::Tensor_Base->(Tensor_Base,Bool)
tool_wedge_product1 Tensor_Base_Zero =(Tensor_Base_Zero,False)
tool_wedge_product1 (Tensor_Base_Cons xs x)=if nx==DAbelian_G_Base_Zero
    then (Tensor_Base_Zero,nb)
    else(Tensor_Base_Cons nxs nx,nb)
    where
        myfun::Tensor_Base->DAbelian_G_Base->(Tensor_Base ,DAbelian_G_Base,Bool)
        myfun Tensor_Base_Zero y =(Tensor_Base_Zero ,y ,False)
        myfun (Tensor_Base_Cons ys z) y=if y<z 
            then (Tensor_Base_Cons ys y,z,True)
            else if y==z
                then (Tensor_Base_Zero,DAbelian_G_Base_Zero,False)
            else (Tensor_Base_Cons ys z,y ,False) 
        (nxs,nx, nb)=myfun xs x


tool_wedge_product2::Tensor_Base->(Tensor_Base,Int)
tool_wedge_product2 Tensor_Base_Zero =(Tensor_Base_Zero,0)
tool_wedge_product2 x=myfun nx
    where
        (nx ,b)=tool_wedge_product1 x
--        (Tensor_Base_Cons ys y,b)=tool_wedge_product1 x
        i=if b then 1 else 0
        myfun::Tensor_Base->(Tensor_Base,Int)
        myfun Tensor_Base_Zero=(Tensor_Base_Zero,0)
        myfun (Tensor_Base_Cons ys y)=(Tensor_Base_Cons nys y,i Prelude.+ ni)
            where
                (nys,ni)=tool_wedge_product2 ys 


tool_wedge_product3::(Num a,Eq a)=>Tensor_Base_RM a->Tensor_Base_RM a
tool_wedge_product3 Tensor_Base_RM_Zero=Tensor_Base_RM_Zero
tool_wedge_product3 t=if b
    then tool_wedge_product3 nt
    else
        nt
    where
        (nt,b)=myfun1 t
        myfun1::(Num a,Eq a)=>Tensor_Base_RM a->(Tensor_Base_RM a,Bool)
        myfun1 Tensor_Base_RM_Zero=(Tensor_Base_RM_Zero,False)
        myfun1 (Tensor_Base_RM_Cons r y)=if ny==Tensor_Base_Zero
            then (Tensor_Base_RM_Zero,False)
            else if (mod i 2)==0
            then
                if i==0
                then (Tensor_Base_RM_Cons r ny,False)
                else
                    (Tensor_Base_RM_Cons r ny,True)
            else
                (Tensor_Base_RM_Cons (-r) ny,True)
            where
                (ny,i)=tool_wedge_product2 y



instance (Num a,Eq a)=>Wedges_Product (DTensor a) where
    DTensor_Zero <^> _ =DTensor_Zero
    _ <^> DTensor_Zero =DTensor_Zero
    x <^>y= myfun (x Algebras.<*> y)
         where 
            myfun:: (Num a,Eq a)=>DTensor a->DTensor a
            myfun DTensor_Zero =DTensor_Zero
            myfun  (DTensor_Cons ys y)=if ny==Tensor_Base_RM_Zero
                then myfun ys
                else DTensor_Cons (myfun ys) ny
                where 
                    ny=tool_wedge_product3 y






test1::IO Int
test1=do
    putStrLn "one"
    return 1

someFunc :: IO ()
someFunc =do

    t<- return $ create_tensor [(0.8,[("V",4),("V",2)]),((-9.9),[("V*",5),("V*",6)])]
    t1<- return $ create_tensor [(-9.1,[("V",7)]),(-0.012,[("V",2)])]
    t2<- return $ t Algebras.<^> t1

    --tm<-return $ create_tensor_brm (-9.6,[("V",4),("V",2),("V",2)])
   -- i<- test1

    --j<- return $ i Prelude.+1 
   --- putStrLn $ show $ test2 tm
    putStrLn $ show $ tensor2list t2
    --t2<- return $ create_tensor [([4,2],8.9)]
    ---putStrLn $ show $ tensor2list $ t Algebras.+ t2  
    --putStrLn $ show $ create_tensor_brm ([0,2], 0.9 )
    putStrLn "someFunc"
